home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / sml_nj / 93src.lha / src / dbguser / emacs.sml < prev    next >
Encoding:
Text File  |  1993-01-27  |  6.9 KB  |  219 lines
  1. (* Emacs Display functions. *)
  2.  
  3.  (** Display functions.  sml can be run inside emacs using a sml mode written
  4.   ** in Emacs Lisp (see sml-mode.el, sml-debug.el).
  5.   ** All display updates are performed through these functions. *)
  6.  
  7. structure UserDebugEmacs =
  8. struct
  9.  local
  10.  open UserDebugUtil UserDebugInterface UserDebugBreaks
  11.  in
  12.  val emacs = ref false     (* Are we running sml in an Emacs window? *)
  13.  
  14.  fun emacsInit () = (* Emacs sends a "emacsInit()" when an sml window starts *)
  15.      (emacs := true;
  16.       set_term_in (IO.std_in, true);
  17.       set_term_out (IO.std_out, true))
  18.  
  19.  (* currentEv is the event that is displayed as the current event.
  20.   * Each time that execution stops, currentEv is set to the value
  21.   * returned by currentPlace().*)
  22.  
  23.  val currentEv = ref (NONE : place option)
  24.  
  25.  (* The selected event is an event which the user uses as a cursor
  26.   * to browse through and choose events. *)
  27.  
  28.  val selected = ref (NONE : place option)
  29.  
  30.  (* The backtrace event is the event which the user has chosen by moving
  31.   * up and down in the calling stack.  We store an index into the "stack"
  32.   * as well as the (where, when) of the trace event, since Ycaller is 
  33.   * expensive. *)
  34.  val backtrace = ref (NONE : (int * wherewhen) option)  
  35.  
  36.  fun emacsMessage message =
  37.      printL ["(emacs (message \"", message, "\"))\n"]
  38.  
  39.  (* Filename for events in run text is "<instream>". *)
  40.  val runName = "<instream>"
  41.  val runBufferName = "*smld-run*"
  42.  
  43.  (* Filename for events in interpolations is "<interpolation>". *)  
  44. (*  val executeName = "<interpolation>"
  45.     val executeBufferName = "*smld-execute*" *)
  46.  
  47.  fun emacsCreateBuffer name contents =
  48.      printL ["(emacs (sml-create-buffer \"", name, "\" \"", contents, "\"))\n"]
  49.  
  50.  fun emacsKillBuffer bufName =
  51.      printL ["(emacs (sml-kill-buffer \"", bufName, "\"))\n"]
  52.  
  53.  fun emacsError s =
  54.      printL ["(emacs (sml-error \"", s, "\"))\n"]
  55.  
  56.  fun emacsLabelCommand display file (pos:int) string cursor =
  57.  (* Display (display = true) or undisplay (display = false) a label in an
  58.   * Emacs buffer.  For displaying, cursor should have the value SOME b,
  59.   * where b represents whether we should move the cursor to the beginning
  60.   * of the label. *)
  61.      printL ["(emacs (sml-",
  62.          if display then "label" else "unlabel",
  63.          "-buffer \"",
  64.          if file = runName then 
  65.            runBufferName 
  66. (*         else if file = executeName then
  67.            executeBufferName *)
  68.             else file,
  69.          "\" ", makestring pos,
  70.          " \"", string, "\"",
  71.          case cursor of SOME b => if b then " t" else " nil" | NONE => "",
  72.          "))\n"]
  73.  
  74.  
  75.  fun emacsGoodBye () =
  76.      printL ["(emacs (sml-good-bye))\n"]
  77.  
  78.  fun emacsEvent display ev =
  79.  (* Display (display = true) or undisplay (display = false) a given event.
  80.   * An event is only displayed if
  81.       - it is the selected event
  82.       - it is the current event
  83.       - it is the backtrace event
  84.       - there is a breakpoint at that event *)
  85.      let val isSelected = eqOption (ev, !selected)
  86.      val isCurrent = eqOption (ev, !currentEv)
  87.      val isBacktrace =
  88.            case !backtrace of
  89.          SOME (i, (where, when)) =>
  90.              if ev = where then
  91.                SOME when
  92.              else NONE
  93.            | NONE => NONE
  94.      val isBreakpoint = isSome (breakId ev)
  95.      val displayed = isSelected orelse isCurrent orelse
  96.              isSome(isBacktrace) orelse isBreakpoint
  97.      in
  98.      if displayed then
  99.          let val s =
  100.          implode [if isSelected then "[" else "<",
  101.               case breakId ev of
  102.                   NONE => ""
  103.                 | SOME bn =>
  104.                   if isSome (getBreakFunc bn)
  105.                       then "bk*:"
  106.                       else "bk:",
  107.               eventText ev,
  108.               if isCurrent then
  109.                   ":" ^ (makestring (establishedTime()))
  110.                   else "",
  111.               case isBacktrace of
  112.                   SOME when => ":bt:" ^ (makestring when)
  113.                 | NONE => "",
  114.               if isSelected then "]" else ">"]
  115.          in case eventLocation ev of
  116.           SOME (file,pos) =>
  117.                      emacsLabelCommand display file pos s
  118.                   (if display then SOME isSelected else NONE)
  119.             | NONE => if display then 
  120.                     emacsError ("No source available for " ^ s)
  121.               else ()
  122.          end
  123.      else ()
  124.      end
  125.  
  126.  val emacsDisplay = emacsEvent true
  127.  val emacsUndisplay = emacsEvent false
  128.  
  129.  fun emacsModify evl f =
  130.  (* Perform a function that may modify the appearance of the given events. *)
  131.      let val evl' = uniq evl in    (* don't display or undisplay an event twice *)
  132.      (app emacsUndisplay evl';
  133.       f ();
  134.       app emacsDisplay evl')
  135.      end
  136.  
  137.  fun emacsSelect ev =
  138.  (* Select the given event and update the display.
  139.   * The selected event is the one on which the event cursor rests. *)
  140.      emacsModify (somes [!selected, ev]) (fn () => selected := ev)
  141.  
  142.  exception SetBackTrace
  143.  fun emacsSetBackTrace (bt:int option) = 
  144.  (* Set the backtrace event to that indexed by the given integer in the
  145.   * call trace list, or to NONE; selects the backtrace event, or the
  146.   * current event if there is no backtrace event.
  147.   * Updates the display. *)
  148.      let val cww = safeQuery(fn t => (hd(YcurrentPlaces()),t))
  149.          val new = case bt of
  150.          SOME n =>
  151.            (case (case !backtrace of 
  152.             SOME (n',ww') => 
  153.               if n' < n then 
  154.                 traceEvent ww' (n-n')
  155.               else traceEvent cww n 
  156.               | NONE => traceEvent cww n) of
  157.           SOME ww => SOME (n, ww)
  158.         | NONE => raise SetBackTrace)
  159.        | NONE => NONE
  160.      val oldEv = onSome(#1 o #2, !backtrace)
  161.        (* event number of old backtrace event *)
  162.      val newEv = onSome(#1 o #2, new)
  163.      val newSel = case newEv of
  164.                SOME e => SOME e
  165.              | NONE => !currentEv
  166.      in
  167.      emacsModify (somes [oldEv, newEv, !selected, newSel])
  168.        (fn () => (backtrace := new;
  169.               selected := newSel))
  170.      end
  171.  
  172.  fun emacsSetCurrent ev =
  173.  (* Set the current event, updating the display appropriately. *)
  174.      emacsModify (somes [!currentEv, ev]) (fn () => currentEv := ev)
  175.  
  176.  (* The functions emacsDeselect and emacsUpdate could be expressed using
  177.   * the three functions above, but call emacsModify themselves to optimize
  178.   * the number of emacs commands that are generated. *)
  179.  
  180.  fun emacsDeselect () =
  181.  (* Invoked each time before execution begins.
  182.   * Reset the selected, backtrace and current events. *)
  183.      emacsModify (somes [!selected, onSome(#1 o #2, !backtrace),
  184.              !currentEv]) (fn () =>
  185.                        (selected := NONE;
  186.                     backtrace := NONE;
  187.                     currentEv := NONE))
  188.  
  189.  fun emacsUpdate () =
  190.  (* Invoked each time that execution stops, to set the current and selected
  191.   * events. *)
  192.      let val where = SOME(establishedPlace()) in
  193.          emacsModify (somes [!currentEv, !selected, where])
  194.          (fn () => (currentEv := where; selected := where))
  195.      end
  196.  
  197.  local 
  198.    val runBuffer = ref false
  199.  in 
  200.    fun emacsInitDebug sopt =
  201.      ((* emacsCreateBuffer executeBufferName ""; *)
  202.       case sopt of
  203.     SOME s => (emacsCreateBuffer runBufferName s; 
  204.            runBuffer := true)
  205.       | NONE => runBuffer := false;
  206.       emacsUpdate())
  207.  
  208.   fun emacsTermDebug () = 
  209.     (emacsDeselect();
  210.      if (!runBuffer) then
  211.        emacsKillBuffer runBufferName
  212.      else() (* ;
  213.      emacsKillBuffer executeBufferName *))
  214.  end 
  215.  
  216.  end (* local *)
  217.  
  218. end (* structure *)
  219.